Workbench Add-On/Workbench Add-On - Volume 1.iso/BBS-Archive/Dev/Obrn-A_1.6_lib.lha/oberon-a/source3.lha/source/Library/Strings.mod

Text File | 1995-06-29 | 5KB | 219 lines

(***************************************************************************

     $RCSfile: Strings.mod $
  Description: String manipulation

   Created by: fjc (Frank Copeland)
    $Revision: 1.10 $
      $Author: fjc $
        $Date: 1995/06/04 23:22:41 $

  Copyright © 1994, Frank Copeland.
  This file is part of the Oberon-A Library.
  See Oberon-A.doc for conditions of use and distribution.

***************************************************************************)

<*$ IndexChk- *>

(* Index checking is handled explicitly by the relevant procedures. *)

MODULE Strings;

IMPORT SYS := SYSTEM;


PROCEDURE Min ( a, b : INTEGER ) : INTEGER;
BEGIN (* Min *)
  IF a < b THEN RETURN a
  ELSE RETURN b
  END
END Min;


PROCEDURE Length *
  ( s : ARRAY OF CHAR )
  : INTEGER;

  VAR len : INTEGER;

<*$CopyArrays-*>
BEGIN (* Length *)
  len := SHORT (SYS.STRLEN (s));
  RETURN Min (SHORT (LEN (s)), len)
END Length;


PROCEDURE Append *
  ( extra    : ARRAY OF CHAR;
    VAR dest : ARRAY OF CHAR );

  VAR max, len1, len2 : INTEGER;

<*$CopyArrays-*>
BEGIN (* Append *)
  len1 := Length (dest); max := SHORT (LEN (dest)); DEC (max);
  IF len1 < max THEN
    (* There is actually room at the end of the array. *)
    len2 := Min (len1 + Length (extra), max);
    SYS.MOVE (SYS.ADR (extra), SYS.ADR (dest [len1]), len2 - len1 );
    dest [len2] := 0X;
  END
END Append;


PROCEDURE Insert *
  ( source   : ARRAY OF CHAR;
    pos      : INTEGER;
    VAR dest : ARRAY OF CHAR );

  VAR max, len1, len2 : INTEGER;

<*$CopyArrays-*>
BEGIN (* Insert *)
  len1 := Length (source); len2 := Length (dest);
  max := SHORT (LEN (dest)); DEC (max);
  IF (pos >= len2) THEN
    (* The start position is past the end of the target string. *)
    Append (dest, source)
  ELSIF ((len1 + len2) <= max) THEN
    (*
      The result will fit into the target string. Move characters towards
      the end of the string to make room and copy the new characters into
      the space.
    *)
    SYS.MOVE
      ( SYS.ADR (dest [pos]), SYS.ADR (dest [pos + len1]), len2 - pos );
    SYS.MOVE (SYS.ADR (source), SYS.ADR (dest [pos]), len1);
    dest [len2 + len1] := 0X
  ELSIF ((pos + len1) < max) THEN
    (*
      The result will overflow the target string, but the subString will
      fit. Move characters towards the end of the string to make room and
      copy the new characters into the space.
    *)
    SYS.MOVE
      ( SYS.ADR (dest [pos]), SYS.ADR (dest [pos + len1]),
        max - len1 - pos );
    SYS.MOVE ( SYS.ADR (source), SYS.ADR (dest [pos]), len1 );
    dest [max] := 0X
  ELSE
    (*
      The result will overflow the target string, and the subString is too
      long to fit. Just discard the end of the target string and append
      the new characters to it.
    *)
    dest [pos] := 0X; Append (dest, source)
  END
END Insert;


PROCEDURE Delete *
  ( VAR s  : ARRAY OF CHAR;
    pos, n : INTEGER );

  VAR len : INTEGER;

BEGIN (* Delete *)
  IF n > 0 THEN
    len := Length (s);
    IF pos < len THEN
      IF (pos + n) < len THEN
        (* Move characters towards the front of the array into the space
        ** deleted.
        *)
        SYS.MOVE
          ( SYS.ADR (s [pos + n]), SYS.ADR (s [pos]), len - (pos + n) );
        s [len - n] := 0X;
      ELSE (* Delete to the end of the string. *)
        s [pos] := 0X;
      END
    END
  END
END Delete;


PROCEDURE Replace *
  ( source   : ARRAY OF CHAR;
    pos      : INTEGER;
    VAR dest : ARRAY OF CHAR );

<*$CopyArrays-*>
BEGIN (* Replace *)
  Delete (dest, pos, Length (source)); Insert (source, pos, dest)
END Replace;


PROCEDURE Extract *
  ( source   : ARRAY OF CHAR;
    pos, n   : INTEGER;
    VAR dest : ARRAY OF CHAR );

  VAR len1, len2 : INTEGER;

<*$CopyArrays-*>
BEGIN (* Extract *)
  len2 := 0;
  IF n > 0 THEN
    len1 := Length (source);
    IF (pos < len1) THEN
      len2 := Min ( Min (n, SHORT (LEN (dest)) - 1), len1 - pos);
      SYS.MOVE (SYS.ADR (source [pos]), SYS.ADR (dest), len2);
    END
  END;
  dest [len2] := 0X;
END Extract;


PROCEDURE Pos *
  ( pattern, s : ARRAY OF CHAR;
    pos        : INTEGER )
  : INTEGER;

  VAR
    result, i, len1, len2 : INTEGER;
    found, match : BOOLEAN;

<*$CopyArrays-*>
BEGIN (* Pos *)
  result := -1;
  IF pos >= 0 THEN
    len1 := Length (pattern); len2 := Length (s);
    IF (len1 = 0) OR (len2 = 0) OR (pos >= len2) THEN
      result := -1
    ELSE
      found := FALSE;
      WHILE ~found & ((len2 - pos) >= len1) DO
        IF s [pos] = pattern [0] THEN
          match := TRUE; i := 0;
          WHILE match & (i < len1) DO
            IF s [pos + i] = pattern [i] THEN INC (i)
            ELSE match := FALSE
            END
          END;
          found := match
        ELSE
          INC (pos)
        END
      END;
      IF found THEN result := pos END
    END
  END;
  RETURN result
END Pos;


PROCEDURE Cap *
  ( VAR s : ARRAY OF CHAR );

  VAR index : INTEGER; ch : CHAR;

BEGIN (* Cap *)
  index := 0; ch := s [0];
  WHILE ch # 0X DO
    s [index] := CAP (ch); INC (index); ch := s [index]
  END
END Cap;

END Strings.